home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Toolbox classes / pictures < prev    next >
Text File  |  1993-02-01  |  2KB  |  58 lines

  1. \ 2.1.87    rfl version
  2. \ 4.28.88    rfl moveto needs work
  3. \ 8.31.88    rfl added theClip to this source
  4. \ 8.14.90    rfl moveto fixed
  5.  
  6. \ NOTE: not yet converted to Mops!!****************************
  7.  
  8.  
  9. rect theClip    \ global clip rectangle
  10. -1000 dup 1000 dup put: theClip
  11.  
  12. : +pair { x1 y1 x2 y2 -- x1+y1 x2+y2 } x1 x2 + y1 y2 + ;
  13.  
  14. \ Interface object for QD picture support
  15. :CLASS Picture  <Super Object
  16.  
  17.     Handle    picHndl
  18.     Int        resID        \ resource ID if it is a resource
  19.     Rect    DestRect    \ destination rectangle for drawing
  20.  
  21.     \ ( l t r b -- )  Open a new pict with given frame
  22.     :M  OPEN:  Put: destrect  0 abs: destrect call OpenPicture
  23.         Put: picHndl  ;M
  24.  
  25.     \ ( -- )  terminate this picture definition
  26.     :M  CLOSE:  call ClosePicture   ;M
  27.  
  28.     \ ( resID -- )
  29.     :M INIT:  put:  resID  ;M
  30.  
  31.     \ load the picture from a resource file
  32.     :M  GETNEW:  0 int: resID  call GetPicture  put: picHndl
  33.         ptr: picHndl  2+ get: rect  put: destRect   ;M
  34.  
  35.     \ ( w h -- )  Set size in pixels of dest rect
  36.     :M  SIZE:   getTop:  destRect  +Pair  putBot: destRect ;M
  37.  
  38.     \ ( x y -- )  Move dest rect to given location
  39.     :M  GOTO:  { x y -- }   Size: destRect  x y putTop: DestRect
  40.         Size: self  ;M
  41.  
  42.     \ ( -- )  Draw the picture in destRect
  43.     :M  DRAW:  get: picHndl abs: destRect
  44.         call DrawPicture   ;M
  45.  
  46.     \ ( x y resID -- )  Combines the actions of init:, getNew:, goto: & draw:
  47.     :M  DISP:  init: self  getNew: self  goto: self  draw: self  ;M
  48.  
  49.     \ goto to location and draw self
  50.     :M  MOVETO: ( x y -- ) goto: self draw: self ;M
  51.  
  52.     \ ( -- )  dispose of picture heap
  53.     :M  KILL:  get: picHndl  call KillPicture   ;M
  54.  
  55. ;CLASS
  56.  
  57.  
  58.